home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl720 / fast278j.lzh / PC.F < prev    next >
Text File  |  1980-01-01  |  7KB  |  370 lines
  1. ;PC - Doucument reporter. (C) PC 16/5/1988
  2.  
  3. ;03/08/91  Default to reading *.* files, not *.doc
  4.  
  5.  
  6. const maxd=1024,blen=512       ;BLEN >= 256
  7. var cd,m,mad,loc,wordstar,ds
  8. var32 topscr,botscr,fseek,secondline,fad,atemp
  9. fbuf ? blen
  10.  
  11. #include fsort.fi
  12.  
  13. on error
  14.     {
  15.     print bios
  16.     error msg "\dos.err"
  17.     print bios "!"
  18.     terminate
  19.     }
  20.  
  21. proc clear_bot
  22.     {
  23.     colour 7
  24.     scroll 0,20,79,24,0
  25.     cursor 20,0
  26.     locate 20,0
  27.     }
  28.  
  29. proc show_ws
  30.     {
  31.     colour 7
  32.     locate 2,70:print " WS ";
  33.     if wordstar=255 then print "OFF "; else print "ON  ";
  34.     }
  35.  
  36. function fill_buffer
  37.     {
  38.     fill blen/2 from fbuf with 1a1ah
  39.     read_len=read #1,blen to fbuf
  40.     return fbuf
  41.     }
  42.  
  43. proc get_eof
  44.     {
  45.     seek #1,eof
  46.     rax=reg ax:rdx=reg dx
  47.     topscr=rax+rdx*65536 ;Current address for TOPSCR.
  48.     }
  49.  
  50. proc backline(clines)
  51.     {
  52.     const backlen=160
  53.     repeat clines
  54.     {
  55.     fad=topscr-backlen
  56.     if (high fad)<0 then topscr=0:return
  57.     seek #1,fad
  58.     fill backlen/2+1 from fbuf with 1a1ah
  59.     read_len=read #1,backlen to fbuf
  60.     m=fbuf
  61.  
  62.     atemp=fad
  63.     next_line13:
  64.     col=0
  65.     back_loop:
  66.     c=peekb m:m++
  67.     if c>31 then
  68.         {
  69.         back_print:
  70.         col++
  71.         if col<80 then goto back_loop
  72.         c=13
  73.         }
  74.     if c=26 then goto next_backline
  75.     if c=13 then
  76.         {
  77.         ad32=m-fbuf
  78.         topscr=atemp
  79.         atemp=fad+ad32
  80.         goto next_line13
  81.         }
  82.     if c<>9 then goto back_print
  83.     col=(col and 248)+8
  84.     goto back_loop
  85.  
  86.     next_backline:
  87.     }
  88.     }
  89.  
  90. proc position(addr)
  91.     {
  92.     px=addr mod 6
  93.     py=addr/6
  94.     locate 3+py,px*13+1
  95.     }
  96.  
  97. proc pos_colour(colc)
  98.     {
  99.     repeat 2 video[locpos+1]b=colc:locpos+=2
  100.     while video[locpos-2]b<>' ' video[locpos+1]b=colc:locpos+=2
  101.     cursor 3+py,px*13+2
  102.     }
  103.  
  104. function get_char
  105.     {
  106.     if m>=(fbuf+blen) then
  107.     {
  108.     m=fill_buffer
  109.     }
  110.     else m++
  111.     return peekb m
  112.     }
  113.  
  114. proc get_files
  115.     {
  116.     xd=ffind
  117.     while peekb    xd print bios chr peekb    xd;:xd++
  118.     print bios " ";
  119. #errors    off
  120.     find first ffind
  121.     goto entry
  122.  
  123.     while cd<maxd
  124.     {
  125.     find next
  126. #errors    on
  127.     entry:
  128.     if error then return
  129.     moveb 13 from dta segment|dta offset+30 to ds|mad
  130.     mad+=13:cd++
  131.     }
  132.     }
  133.  
  134. proc open_file
  135.     {
  136.     moveb 13 from ds|loc*13 to fbuf
  137.     open #1,fbuf
  138.     clear_bot
  139.     colour 70h:locate 2,2
  140.     pm=fbuf
  141.     while peekb pm print chr peekb pm;:pm++
  142.     show_ws
  143.     }
  144.  
  145. proc display_file
  146.     {
  147.     open_file
  148.     topscr=0
  149.  
  150.     forever
  151.     {
  152.     seek #1,topscr
  153.     eof_flag=0:pagelen=0
  154.     m=fbuf+blen
  155.     for y=3 to 18
  156.     ad32=m-fbuf
  157.     if y=4 then secondline=topscr+ad32
  158.  
  159.     locate y,0
  160.     col=0
  161.     loop_prt:
  162.     if m>=(fbuf+blen) then m=fill_buffer
  163.     c=peekb m:m++:pagelen++
  164.     if c>31 then
  165.         {
  166.         print_char:
  167.         col++:print chr c and wordstar;
  168.         if col<80 then goto loop_prt
  169.         c=13 ; Start new line.
  170.         }
  171.     if c=26 then print "<EOF>";:eof_flag=1:goto fill_end
  172.     if c=13 then
  173.         {
  174.         if col<80 then fill (80-col) from video|locpos with 0720h
  175.         goto next_line
  176.         }
  177.     if c=10 then goto loop_prt ; Skip printing this character.
  178.     if c<>9 then goto print_char
  179.     ncol=(col and 248)+8
  180.     repeat ncol-col print " ";
  181.     col=ncol
  182.     goto loop_prt
  183.  
  184.     next_line:
  185.     next y
  186.  
  187.     fill_end:
  188.     fl=19*160-locpos
  189.     if fl>0 then fill fl/2 from video|locpos with 0720h
  190.  
  191.     botscr=topscr+pagelen
  192.     wait_eof:
  193.     wait for keypressed
  194.     s=scan
  195.  
  196.     if s=45 then goto abort ; X to abort.
  197.     if s=1 then goto finish_display
  198.     if s=17 then
  199.         {
  200.         wordstar=wordstar xor 128
  201.         show_ws
  202.         goto next_display
  203.         }
  204.  
  205.     if s=71 then topscr=0:goto next_display
  206.     if s=72 then backline(1):goto next_display
  207.     if s=73 then backline(16):goto next_display
  208.  
  209.     if eof_flag then goto wait_eof
  210.  
  211.     if s=79 then get_eof:backline(15):goto next_display
  212.     if s=80 then topscr=secondline:goto next_display
  213.     ;if s=81 then do nothing, default is view next page.
  214.  
  215.     topscr=botscr
  216.     next_display:
  217.     }
  218.  
  219.     finish_display:
  220.     close #1
  221.     }
  222.  
  223. proc print_file
  224.     {
  225.     open_file
  226.     cursor 20,0:print bios "Press ESC to abort printing. "
  227.     m=fbuf+blen
  228.  
  229.     print_line:
  230.     col=0
  231.     print_loop:
  232.     if m>=(fbuf+blen) then m=fill_buffer
  233.     c=peekb m:m++
  234.     if c>31 then
  235.     {
  236.     lprint_char:
  237.     col++:lprint chr c and wordstar;
  238.     goto print_loop
  239.     }
  240.     if c=26 then lprint ff;:goto print_end
  241.     if c=13 then
  242.     {
  243.     lprint
  244.     if key=27 then goto print_end
  245.     goto print_line
  246.     }
  247.     if c=10 then goto print_loop ; Skip printing this character.
  248.     if c<>9 then goto lprint_char
  249.     ncol=(col and 248)+8
  250.     repeat ncol-col lprint " ";
  251.     col=ncol
  252.     goto print_loop
  253.  
  254.     print_end:
  255.     close #1
  256.     }
  257.  
  258. proc ddir(mad)
  259.     {
  260.     mad*=13
  261.     mn=0
  262.  
  263.     while (mn<96) and ((mad/13)<cd)
  264.     {
  265.     position(mn)
  266.     locpos+=2
  267.     a=mad
  268.     print chr ucase ds[a]b;
  269.     a++:l=12
  270.     while ds[a]b print chr lcase ds[a]b;:a++:l--
  271.     mad+=13
  272.     mn++
  273.     while l print " ";:l--
  274.     }
  275.     while mn<96 position(mn):mn++:print "             ";
  276.     }
  277.  
  278.  
  279. wordstar=255
  280. ds=allocate (maxd*13)/16+15
  281.  
  282. mad=0
  283. cd=0
  284. print bios "Reading files... ";
  285. #errors    off
  286. open #1,"\PC.FIL":if error then    get_files:goto start_display
  287. #errors    on
  288.  
  289. m=fbuf+blen
  290. loopf:
  291. c=get_char
  292. loopf2:
  293. if c=26 then goto start_display
  294. if c<=' ' then goto loopf
  295. a=ffind
  296. while c>' '
  297.     {
  298.     pokeb a,ucase c
  299.     a++
  300.     if a>=str_end then error 13
  301.     c=get_char
  302.     }
  303.  
  304. gf_execute:
  305. pokeb a,0
  306. get_files
  307. if cd<maxd then goto loopf2
  308.  
  309. start_display:
  310. close #1
  311. drawloc=0:loc=0
  312.  
  313. if not cd then error 18
  314. if not sort(ds,0,13,cd)    then error 1
  315.  
  316. display:
  317. cls
  318. colour 71h:locate 0,7
  319. print " PC - Document reporter. Written by Peter Campbell, version 1.2 "
  320. colour 6:locate 1,0
  321. print " Use ARROWS to select file, ENTER to display file on screen or P to print file."
  322. colour 7
  323. repeat 80 print chr 196;
  324. locate 19,0
  325. repeat 80 print chr 196;
  326. show_ws
  327. colour 7
  328. locate 19,2:print " ";cd;" Files. ";
  329. goto redis2
  330.  
  331. redis:
  332. drawloc=(loc/6)*6
  333. redis2:
  334. ddir(drawloc)
  335.  
  336. forever
  337.     {
  338.     clear_bot
  339.     position(loc-drawloc)
  340.     pos_colour(70h)
  341.     wait for keypressed
  342.     ks=keyscan:s=high ks:k=lcase low ks
  343.  
  344.     position(loc-drawloc)
  345.     pos_colour(7)
  346.     if k=27 then goto abort
  347.     if k='p' then print_file:goto display
  348.     if k=13 then display_file:goto display
  349.     loc-=s=75
  350.     loc+=s=77
  351.     if s=72 then loc-=6
  352.     if s=80 then loc+=6
  353.     if s=71 then loc=0
  354.     if s=79 then loc=cd-1
  355.     if s=73 then loc-=96
  356.     if s=81 then loc+=96
  357.     if loc<0 then loc=0
  358.     if loc>cd-1 then loc=cd-1
  359.     if (loc<drawloc) or (loc>(drawloc+95)) then goto redis
  360.     }
  361.  
  362. abort:
  363. clear_bot
  364. terminate
  365.  
  366. ffind:
  367. fname '*.*'
  368. space 29    ;Total length=32
  369. str_end:
  370.